home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel0_89.lha / Feel / Libs / CSP / short-path.em < prev    next >
Encoding:
Text File  |  1993-07-18  |  6.6 KB  |  244 lines
  1. (defmodule short-path
  2.   (standard0
  3.    loopsII
  4.    list-fns
  5.    csp) ()
  6.  
  7.   ;; note that this program will fail on graphs with 
  8.   ;; cycles
  9.   
  10.   ;; From Naff benchmarks ltd.
  11.  
  12.   (defun time (f) (let ((x (cpu-time)))
  13.             (f)
  14.             (- (cpu-time)
  15.                x)))
  16.  
  17.   (defun m1 () (main *weird-arcs* 6))
  18.  
  19.   ;; one-shot speedups:
  20.   ;; n-procs   time on invoking processor
  21.   ;;  1        410            1.0
  22.   ;;  2        229            1.79
  23.   ;;  3        166            2.47
  24.   ;;  4        217 ????       1.89
  25.  
  26.   ;; DEF maxval=3000, termin=99 :
  27.   ;;
  28.   ;;PROC originmode(VALUE m,CHAN out[]) =
  29.   ;;-- outputs path lengths to internal nodes and the terminator tokens
  30.   ;;  SEQ
  31.   ;;    SEQ i=[0 to m]
  32.   ;;      out[i]!1
  33.   ;;    SEQ i_[0 FOR m]
  34.   ;;      out[i]!termin   :
  35.   ;;
  36.   ;;PROC internalnode(VALUE n,m,CHAN in[],out[]) =
  37.   ;;-- stores minimum input path length on any input, and broadcasts
  38.   ;;-- any received value less than the current minimum.  Sends
  39.   ;;-- terminator after receipt of terminator from all inputs
  40.   ;;  VAR minval, endcount  :
  41.   ;;  SEQ
  42.   ;;    minval := maxval        -- initially infinity
  43.   ;;    endcount := 0
  44.   ;;    WHILE TRUE
  45.   ;;      VAR val :
  46.   ;;      ALT i=[0 FOR n]
  47.   ;;        in[i]?val        -- accept any input
  48.   ;;          IF
  49.   ;;            val = termin
  50.   ;;              IF
  51.   ;;                endcount = n-1    -- this is the last
  52.   ;;                  SEQ i=[0 FOR n]
  53.   ;;                    out[i]!termin -- broadcast terminator
  54.   ;;                TRUE
  55.   ;;                  endcount := endcount+1
  56.   ;;            val<minval
  57.   ;;              PAR
  58.   ;;                minval := val
  59.   ;;                SEQ i=[0 FOR m]
  60.   ;;                  out[i]!(val+1)    -- braodcast new minimum
  61.   ;;            TRUE
  62.   ;;              SKIP    :
  63.   ;;
  64.   ;;PROC destinationnode(VALUE n, CHAN in[], numberout) =
  65.   ;;-- stores the minimum value input and outputs minimum when all terminators
  66.   ;;  VAR mindist  :
  67.   ;;  SEQ
  68.   ;;    mindist := maxval        -- initially infinity
  69.   ;;    WHILE TRUE
  70.   ;;      VAR val  :
  71.   ;;      ALT i=[0 FOR n]
  72.   ;;        in[i]?val        -- accept any input
  73.   ;;          IF
  74.   ;;            val = termin
  75.   ;;              IF
  76.   ;;                endcount=n-1    -- last terminator
  77.   ;;                  SEQ
  78.   ;;                    numberout!mindist
  79.   ;;                    STOP
  80.   ;;                TRUE
  81.   ;;                  endcount := endcount+1
  82.   ;;            val < mindist
  83.   ;;              mindist := val
  84.   ;;            TRUE
  85.   ;;              SKIP   :
  86.   ;;                    
  87.   ;;PROC arc(CHAN in,out) =
  88.   ;;  WHILE TRUE
  89.   ;;    VAR val  : 
  90.   ;;    SEQ
  91.   ;;      in?val
  92.   ;;      out!val   :
  93.   ;;
  94.   ;;-- Main program
  95.   ;;CHAN aout[2], bin[1], bout[2], cin[1], cout[2], din[2], dout[1],
  96.   ;;     eout[1], fin[2], screenout  :
  97.   ;;PAR
  98.   ;;  originnode(2,aout)
  99.   ;;  internalnode(1,2,bin,bout)
  100.   ;;  internalnode(1,2,cin,cout)
  101.   ;;  internalnode(2,1,din,dout)
  102.   ;;  internalnode(2,1,ein,eout)
  103.   ;;  destinationnode(2,fin,screenout)
  104.   ;;  arc(aout[0],cin[0])        -- set up arcs
  105.   ;;  arc(aout[1],bin[0])
  106.   ;;  arc(bout[0],din[0])
  107.   ;;  arc(bout[1],ein[0])
  108.   ;;  arc(cout[0],din[1])
  109.   ;;  arc(cout[1],ein[1])
  110.   ;;  arc(dout[0],fin[0])
  111.   ;;  arc(eout[0],fin[1])
  112.   ;;
  113.   ;;-- plus code to print answer
  114.  
  115.   (defun delq (a lst)
  116.     (delete a lst eq))
  117.  
  118.   (deflocal *terminator* -1)
  119.   (deflocal *max-val* 9999)
  120.  
  121.   (defun start-node (out-chans)
  122.     (mapcar (lambda (x) 
  123.           (OUT x 0))
  124.         out-chans)
  125.     (format t "Start Node: Terminators~%\n")
  126.     (mapcar (lambda (x) (OUT x *terminator*))
  127.         out-chans)
  128.     0)
  129.  
  130.   (defun internal-node (inputs outputs min-val)
  131.     (cond ((null inputs)
  132.        (format t "I-Node terminating~%")
  133.        (mapcar (lambda (x) (OUT x *terminator*))
  134.            outputs)
  135.        min-val)
  136.       (t 
  137.        (IN-FROM (input val) inputs
  138.             (cond ((= val *terminator*)
  139.                (internal-node (delq input inputs) outputs min-val))
  140.               ((< val min-val)
  141.                (mapc (lambda (x) (OUT x val))
  142.                  outputs)
  143.                (internal-node inputs outputs val))
  144.               (t (internal-node inputs outputs min-val)))))))
  145.  
  146.   (defun dest-node (inputs output min-val)
  147.     (cond ((null inputs)
  148.        (OUT output min-val)
  149.        min-val)
  150.       (t (IN-FROM (input val) inputs
  151.               (cond ((= val *terminator*)
  152.                  (dest-node (delq input inputs) output min-val))
  153.                 ((< val min-val)
  154.                  (dest-node inputs output val))
  155.                 (t (dest-node inputs output min-val)))))))
  156.  
  157.   (defun arc (in out length)
  158.     (let ((val (IN in)))
  159.       (cond ((= val *terminator*) 
  160.          (OUT out *terminator*)
  161.          length)
  162.         (t (OUT out (+ val length))
  163.            (arc in out length)))))
  164.             
  165.   (defun result-printer (input)
  166.     (let ((x (IN input)))
  167.       (format t  "**Result is: ~a~%" x)
  168.       x))
  169.  
  170.  
  171.   (deflocal n-nodes 6)
  172.   (deflocal *simple-arcs* '((0 1 1) (0 2 1)
  173.                 (1 3 1) (1 4 1)
  174.                 (2 3 1) (2 4 1)
  175.                 (3 5 1) (4 5 1)))
  176.            
  177.   (deflocal *weird-arcs* '((0 1 1) (0 2 2) (0 5 10)
  178.                (1 3 2) (1 4 4)
  179.                (2 3 2) (2 4 1) 
  180.                (3 5 2) (4 5 4)))
  181.  
  182.   ;; make things readable...
  183.   (defun node-in-chan (arc)
  184.     (cadr arc))
  185.   (defun node-out-chan (arc)
  186.     (caddr arc))
  187.   (defun in-node (arc)
  188.     (caar arc))
  189.   (defun out-node (arc)
  190.     (cadar arc))
  191.   (defun arc-length (arc)
  192.     (caddar arc))
  193.     
  194.   (defun main (arcs n-nodes)
  195.     (let ((arc-chans (mapcar (lambda (arc)
  196.                    (list  arc (make-Channel) (make-Channel)))
  197.                  arcs))
  198.       (result-chan (make-Channel)))
  199.       (PAR (FOR (arc-list arc-chans) arc-list
  200.         (setq arc-list (cdr arc-list))
  201.         (format t "Starting arc: ~a\n" (car arc-list))
  202.         (arc (connect-channel-input (node-out-chan (car arc-list)))
  203.              (connect-channel-output (node-in-chan (car arc-list)))
  204.              (arc-length (car arc-list))))
  205.        (start-node
  206.         (mapcar (lambda (x) 
  207.               (connect-channel-output (node-out-chan x)))
  208.             (collect (lambda (arc-data)
  209.                    (cond ((= (in-node arc-data) 0)
  210.                       arc-data)
  211.                      (t nil)))
  212.                  arc-chans)))
  213.        (FOR (i 1) (< i (- n-nodes 1)) (++ i)
  214.         (internal-node
  215.          (mapcar (lambda (x) 
  216.                (connect-channel-input (node-in-chan x)))
  217.              (collect (lambda (arc-data)
  218.                     (cond ((= (out-node arc-data) i)
  219.                        arc-data)
  220.                       (t nil)))
  221.                   arc-chans))
  222.          (mapcar (lambda (x) 
  223.                (connect-channel-output (node-out-chan x)))
  224.              (collect (lambda (arc-data)
  225.                     (cond ((= (in-node arc-data) i)
  226.                        arc-data)
  227.                       (t nil)))
  228.                   arc-chans))
  229.          *max-val*))
  230.        (dest-node 
  231.         (mapcar (lambda (arc-data)
  232.               (connect-channel-input (node-in-chan arc-data)))
  233.             (collect (lambda (arc-data)
  234.                    (cond ((= (out-node arc-data)
  235.                      (- n-nodes 1))
  236.                       arc-data)
  237.                      (t nil)))
  238.                  arc-chans))
  239.         (connect-channel-output result-chan)
  240.         *max-val*)
  241.        (result-printer (connect-channel-input result-chan)))))
  242.   
  243.   )
  244.